(*
 *
 *  This file is part of Aws-OCaml
 *
 *  Aws-OCaml is free software: you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation, either version 3 of the License, or
 *  (at your option) any later 
 *  
 *  Aws-OCaml is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *  
 *  You should have received a copy of the GNU General Public License
 *  along with Aws-OCaml. If not, see <http://www.gnu.org/licenses/>.
 *
 *  command.ml william le ferrand (william@themipsfactory.com) 26/03/2010 09:26
 *
 *)

open Aws_shared.Misc
open Aws_shared.Types
open Aws_shared.Result 

(*
let cache = Aws_shared.Cache.create () 
*)

module CreateDomain = 
struct 
  let raw_exec connection domain = 
    let request = 
      ("AWSAccessKeyId", connection.access_key_id) :: 
	("Action", "CreateDomain") ::
	("DomainName", domain) ::
	("SignatureMethod", "HmacSHA1") ::
	("SignatureVersion", "2") ::
	("Timestamp", current_timestamp ()) :: 
	("Version", "2009-04-15") :: [] in 
   
    let signature = Aws_shared.Authentication.sign connection request in
    let signature = String.sub signature 0 (String.length signature - 1) in

    let full_request = ("Signature", signature) :: request in
      try 
	Aws_shared.Effector.send connection full_request 
      with Http_client.Http_error (_, s) -> raise (Error s)

end

module DeleteDomain = 
struct 
  let raw_exec connection domain = 
    let request = 
      ("AWSAccessKeyId", connection.access_key_id) :: 
	("Action", "DeleteDomain") ::
	("DomainName", domain) ::
	("SignatureMethod", "HmacSHA1") ::
	("SignatureVersion", "2") ::
	("Timestamp", current_timestamp ()) :: 
	("Version", "2009-04-15") :: [] in 

    let signature = Aws_shared.Authentication.sign connection request in
    let signature = String.sub signature 0 (String.length signature - 1) in

    let full_request = ("Signature", signature) :: request in
      try 
	Aws_shared.Effector.send connection full_request 
      with Http_client.Http_error (_, s) -> raise (Error s)
end

module ListDomains = 
struct 
  let raw_exec connection max_domain = 
    let request = 
      ("AWSAccessKeyId", connection.access_key_id) :: 
	("Action", "ListDomains") ::
	("MaxNumberOfDomains", (string_of_int max_domain)) ::
	("SignatureMethod", "HmacSHA1") ::
	("SignatureVersion", "2") ::
	("Timestamp", current_timestamp ()) :: 
	("Version", "2009-04-15") :: [] in 

    let signature = Aws_shared.Authentication.sign connection request in
    let signature = String.sub signature 0 (String.length signature - 1) in

    let full_request = ("Signature", signature) :: request in
      try 
	Aws_shared.Effector.send connection full_request 
      with Http_client.Http_error (_, s) -> raise (Error s)

 let extract result = 
    let response, _ = split_result result in
      List.map (function 		  
		    Xml.Element (_,_, domain_name) -> domain_name | _ -> raise Malformed) response
end

module PutAttributes =
struct 
  let format_attributes replace attributes = 
    let _, r = List.fold_left (fun (c, acc) a -> 
				 (c+1), 
				 ((Printf.sprintf "Attribute.%d.Name" c), a.name) :: 
				   ((Printf.sprintf "Attribute.%d.Value" c), a.value) :: (if replace then ((Printf.sprintf "Attribute.%d.Replace" c), "true") :: acc else acc)) (1, []) attributes in r

  let raw_exec replace connection domain item attributes = 
    let request = 
      ("AWSAccessKeyId", connection.access_key_id) :: 
	("Action", "PutAttributes") ::
	("DomainName", domain) ::
	("ItemName", item) ::
	("SignatureMethod", "HmacSHA1") ::
	("SignatureVersion", "2") ::
	("Timestamp", current_timestamp ()) ::
	("Version", "2009-04-15") :: (format_attributes replace attributes) in

    let signature = Aws_shared.Authentication.sign connection request in
    let signature = String.sub signature 0 (String.length signature - 1) in
    let full_request = 
      ("Signature", signature) :: request in


(*
  let key = Printf.sprintf "%s__%s" domain item in
  Aws_shared.Cache.insert cache key attributes ; 
*)
      try 
	Aws_shared.Effector.send connection full_request 
      with Http_client.Http_error (_, s) -> raise (Error s)

  let exec ?(replace = false) connection domain item attributes  = 
    raw_exec replace connection domain item attributes >>> ignore 
end

module DeleteAttributes =
struct 
  let format_attributes attributes = 
    let _, r = List.fold_left (fun (c, acc) a -> 
				 (c+1), 
				 ((Printf.sprintf "Attribute.%d.Name" c), a.name) :: 
				   ((Printf.sprintf "Attribute.%d.Value" c), a.value) :: acc) (1, []) attributes in r

  let raw_exec connection domain item attributes = 
    let request = 
      ("AWSAccessKeyId", connection.access_key_id) :: 
	("Action", "DeleteAttributes") ::
	("DomainName", domain) ::
	("ItemName", item) ::
	("SignatureMethod", "HmacSHA1") ::
	("SignatureVersion", "2") ::
	("Timestamp", current_timestamp ()) ::
	("Version", "2009-04-15") :: (format_attributes attributes) in

    let signature = Aws_shared.Authentication.sign connection request in
    let signature = String.sub signature 0 (String.length signature - 1) in
    let full_request = 
      ("Signature", signature) :: request in
      
      try 
	Aws_shared.Effector.send connection full_request 
      with Http_client.Http_error (_, s) -> raise (Error s)
end

module GetAttributes = 
struct 

  let raw_exec connection domain item  = 
    let request = 
      ("AWSAccessKeyId", connection.access_key_id) :: 
	("Action", "GetAttributes") ::
	("DomainName", domain) ::
	("ItemName", item) ::
	("SignatureMethod", "HmacSHA1") ::
	("SignatureVersion", "2") ::
	("ConsistentRead", "true") :: (* This should be an option somewhere *)
	("Timestamp", (current_timestamp ())) ::
	("Version", "2009-04-15") :: [] in
      
    let signature = Aws_shared.Authentication.sign connection request in
    let signature = String.sub signature 0 (String.length signature - 1) in
    let full_request = 
      ("Signature", signature) :: request in
      
      try 
	Aws_shared.Effector.send connection full_request
      with Http_client.Http_error (_, s) -> raise (Error s)
	
  let extract result = 
    
    let response, _ = split_result result in 
      
      List.map (function 
		    Xml.Element (_, _, attribute) -> 
		      (match attribute with 
			   Xml.Element (_,_, Xml.PCData (name) :: _) :: 
			     Xml.Element (_,_, Xml.PCData (value) :: _) :: _ -> 
			       { name = name; value = decodeplus value }
			 | _ -> debug "@@@ Er1\n"; 
			     raise Malformed)
		  | _ -> debug "@@@ Er2\n"; raise Malformed) response 

  let exec connection domain item = 
    extract (raw_exec connection domain item)

  let cached_exec ?(bypass = false) connection domain item = 
    (* let key = Printf.sprintf "%s__%s" domain item in *)
      match bypass with 
	| true -> 
	    let attributes = exec connection domain item in 
	      (* Aws_shared.Cache.insert cache key attributes ;  *)
	      attributes 
	| false -> 
	    (*match Aws_shared.Cache.fetch cache key with 
		Some attributes -> attributes 
	      | None -> *)
		  let attributes = exec connection domain item in 
		    (* Aws_shared.Cache.insert cache key attributes ;  *)
		    attributes		      
end
  
module Select = 
  struct 
    let raw_exec ?(token_id = None) connection request  = 
    let request = 
      ("AWSAccessKeyId", connection.access_key_id) :: 
	("Action", "Select") ::
	("SelectExpression", request) ::
	("SignatureMethod", "HmacSHA1") ::
	("SignatureVersion", "2") ::
	("Timestamp", (current_timestamp ())) ::
	("Version", "2009-04-15") :: (match token_id with None -> [] | Some id -> [("NextToken", id)]) in
      
    let signature = Aws_shared.Authentication.sign connection request in
    let signature = String.sub signature 0 (String.length signature - 1) in
    let full_request = 
      ("Signature", signature) :: request in
      
      try 
	Aws_shared.Effector.send connection full_request 
      with Http_client.Http_error (_, s) -> raise (Error s)

   
    let extract result = 
      debug "@@@ splitting result\n"; 
      let response, _ = split_result result in 
	debug "@@@ result splitted\n" ;
      let fetch_attributes = List.map (function 
					   Xml.Element (_,_, 
							Xml.Element (_,_, Xml.PCData (name) :: _) :: 
							  Xml.Element (_,_, Xml.PCData (value) :: _) :: _) -> 
					     { name = name ; value = value }
					 |   Xml.Element (_,_, 
							Xml.Element (_,_, Xml.PCData (name) :: _)  :: _) -> 
					       { name = name ; value = "NOPASSWORD" }
					 | _ -> raise Malformed ) in

	List.fold_left (fun (iteml, tokeno) xmlelt -> 
			  match xmlelt with 
			      Xml.Element (_, _, (Xml.Element (_,_, Xml.PCData (label) :: _))::attributes) -> 
				{ label = label ; attributes = fetch_attributes attributes } :: iteml, tokeno
			    | Xml.Element ("NextToken", _, Xml.PCData (tokenid) :: _ ) -> 
				iteml, Some (Str.global_replace (Str.regexp_string "\n") "" tokenid)
			    | _ -> (iteml, tokeno)) ([], None) response
			 


	  
    let exec ?(token_id = None) connection request = 
      extract (raw_exec ~token_id:token_id connection request)
	    
  end


module Dump =
  struct
    (* This module is .... pedestrian! *)
    
    let exec ?(outfile = None) connection domain = 
           
      let rec additionnal_flush f = function 
	  Some token_id as tno -> 
	    let dmp, tokeno = 
	      Printf.sprintf "select * from %s" domain >>> Select.exec ~token_id:tno connection in
	      f dmp; additionnal_flush f tokeno 
	| None -> ()
      
      and init_flush f = 
	let dmp, tokeno = Printf.sprintf "select * from %s" domain >>> Select.exec connection in
	  f dmp; additionnal_flush f tokeno in

      let attributes_printer c = 
	List.iter (function attr -> 
		     Printf.fprintf c "      <Attribute>\n           <Name>%s</Name>\n           <Value>%s</Value>\n      </Attribute>\n" attr.name attr.value) in
	
      let item_printer c = 
	List.iter (function item -> 
		     Printf.fprintf c "<Item>\n"; 
		     Printf.fprintf c "   <Name>%s</Name>\n" item.label ; 
		     attributes_printer c item.attributes ; 
		     Printf.fprintf c "</Item>\n") in
		     
      let flusher, gc =  
	match outfile with 
	    None -> (function itemlist -> ()), (fun () -> ())
	  | Some filename -> 
	      let oc = open_out filename in 
		Printf.fprintf oc "<DbDump date=%s domain=%s>\n" (current_timestamp ()) domain;  
		(item_printer oc), (fun () -> Printf.fprintf oc "</DbDump>"; close_out oc) in

	(try 
	   init_flush flusher ; 
	   gc ()
	 with e -> gc (); raise e)


  end
